perm filename BASIC.LSP[206,JMC] blob
sn#367503 filedate 1978-07-10 generic text, type T, neo UTF8
(DEFPROP BASICFNS
(BASICFNS ORLIS
ANDLIS
MAPCAR2
MAPCHOOSE
MAPAPP
PRUP
LISTSUBT
LISTSUBTA
CONTAINED
DELETE
PICKOUT
PICKOUTA
NTH
SUBLIS
)
VALUE)
(DEFPROP ORLIS
(LAMBDA(PRED U)
(AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)
(DEFPROP ANDLIS
(LAMBDA(PRED U)
(OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
EXPR)
(DEFPROP MAPCAR2
(LAMBDA(FN U V)
(COND ((NULL U) NIL)
(T
(CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
EXPR)
(DEFPROP MAPCHOOSE
(LAMBDA(PRED FN U)
(COND ((NULL U) NIL)
((PRED (CAR U))
(CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
(T (MAPCHOOSE PRED FN (CDR U)))))
EXPR)
(DEFPROP MAPAPP
(LAMBDA(FN U)
(COND ((NULL U) NIL)
(T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
EXPR)
(DEFPROP PRUP
(LAMBDA(U V)
(COND ((NULL U)
(COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
(T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
EXPR)
(DEFPROP LISTSUBT
(LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
EXPR)
(DEFPROP LISTSUBTA
(LAMBDA(U N Z)
(COND ((EQUAL N 0) Z)
(T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
EXPR)
(DEFPROP CONTAINED
(LAMBDA(U V)
(OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
EXPR)
(DEFPROP DELETE
(LAMBDA(X U)
(COND ((NULL U) NIL)
((EQUAL X (CAR U)) (CDR U))
(T (CONS (CAR U) (DELETE X (CDR U))))))
EXPR)
(DEFPROP PICKOUT
(LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
EXPR)
(DEFPROP PICKOUTA
(LAMBDA(PRED U X Y)
(COND ((NULL U) (CONS X Y))
((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
(T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
EXPR)
(DEFPROP SUBLIS
(LAMBDA (S X) (COND ((ATOM X) ((LAMBDA (Z) (COND ((NULL Z) X) (T (CDR Z))))
(ASSOC X S)))
(T ((LAMBDA (U V) (COND ((AND (EQ U (CAR X)) (EQ V (CDR X))) X)
(T (CONS U V))))
(SUBLIS S (CAR X)) (SUBLIS S (CDR X))))))
EXPR)
(DEFPROP NTH
(LAMBDA (U N) (COND ((EQUAL N 1)(CAR U)) (T (NTH (CDR U) (SUB1 N)))))
EXPR)